home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / SCHEME / GNU / SCM4E1 / !Scm / slib / macwork < prev    next >
Text File  |  1994-06-19  |  4KB  |  141 lines
  1. ;;; -*- Scheme -*-
  2. ;;;; macwork.scm: Will Clinger's macros that work.  Modified by Ken Dickey
  3.  
  4. ; Copyright 1992 William Clinger
  5.  
  6. ; Permission to copy this software, in whole or in part, to use this
  7. ; software for any lawful purpose, and to redistribute this software
  8. ; is granted subject to the restriction that all copies made of this
  9. ; software must include this copyright notice in full.
  10.  
  11. ; I also request that you send me a copy of any improvements that you
  12. ; make to this software so that they may be incorporated within it to
  13. ; the benefit of the Scheme community.
  14.  
  15. ;;; patched by ams for archi version
  16. ;;; (slib:load (in-vicinity (program-vicinity) "mwexpand"))  
  17. (slib:load (in-vicinity (library-vicinity) "mwexpand"))  
  18.  
  19. ;;;; Miscellaneous routines.
  20.  
  21. (define (mw:warn msg . more)
  22.   (display "WARNING from macro expander:")
  23.   (newline)
  24.   (display msg)
  25.   (newline)
  26.   (for-each (lambda (x) (write x) (newline))
  27.         more))
  28.  
  29. (define (mw:error msg . more)
  30.   (display "ERROR detected during macro expansion:")
  31.   (newline)
  32.   (display msg)
  33.   (newline)
  34.   (for-each (lambda (x) (write x) (newline))
  35.         more)
  36.   (mw:quit #f))
  37.  
  38. (define (mw:bug msg . more)
  39.   (display "BUG in macro expander: ")
  40.   (newline)
  41.   (display msg)
  42.   (newline)
  43.   (for-each (lambda (x) (write x) (newline))
  44.         more)
  45.   (mw:quit #f))
  46.  
  47. ; Given a <formals>, returns a list of bound variables.
  48.  
  49. (define (mw:make-null-terminated x)
  50.   (cond ((null? x) '())
  51.     ((pair? x)
  52.      (cons (car x) (mw:make-null-terminated (cdr x))))
  53.     (else (list x))))
  54.  
  55. ; Returns the length of the given list, or -1 if the argument
  56. ; is not a list.  Does not check for circular lists.
  57.  
  58. (define (mw:safe-length x)
  59.   (define (loop x n)
  60.     (cond ((null? x) n)
  61.       ((pair? x) (loop (cdr x) (+ n 1)))
  62.       (else -1)))
  63.   (loop x 0))
  64.  
  65. (require 'common-list-functions)
  66.  
  67. ; Given an association list, copies the association pairs.
  68.  
  69. (define (mw:syntax-copy alist)
  70.   (map (lambda (x) (cons (car x) (cdr x)))
  71.        alist))
  72.  
  73. ;;;; Implementation-dependent parameters and preferences that determine
  74. ; how identifiers are represented in the output of the macro expander.
  75. ;
  76. ; The basic problem is that there are no reserved words, so the
  77. ; syntactic keywords of core Scheme that are used to express the
  78. ; output need to be represented by data that cannot appear in the
  79. ; input.  This file defines those data.
  80.  
  81. ; The following definitions assume that identifiers of mixed case
  82. ; cannot appear in the input.
  83.  
  84. ;(define mw:begin1  (string->symbol "Begin"))
  85. ;(define mw:define1 (string->symbol "Define"))
  86. ;(define mw:quote1  (string->symbol "Quote"))
  87. ;(define mw:lambda1 (string->symbol "Lambda"))
  88. ;(define mw:if1     (string->symbol "If"))
  89. ;(define mw:set!1   (string->symbol "Set!"))
  90.  
  91. (define mw:begin1  'begin)
  92. (define mw:define1 'define)
  93. (define mw:quote1  'quote)
  94. (define mw:lambda1 'lambda)
  95. (define mw:if1     'if)
  96. (define mw:set!1   'set!)
  97.  
  98. ; The following defines an implementation-dependent expression
  99. ; that evaluates to an undefined (not unspecified!) value, for
  100. ; use in expanding the (define x) syntax.
  101.  
  102. (define mw:undefined (list (string->symbol "Undefined")))
  103.  
  104. ; A variable is renamed by suffixing a vertical bar followed by a unique
  105. ; integer.  In IEEE and R4RS Scheme, a vertical bar cannot appear as part
  106. ; of an identifier, but presumably this is enforced by the reader and not
  107. ; by the compiler.  Any other character that cannot appear as part of an
  108. ; identifier may be used instead of the vertical bar.
  109.  
  110. (define mw:suffix-character #\|)
  111.  
  112. ;; these two patched by ams for archi version
  113. ;; (slib:load (in-vicinity (program-vicinity) "mwdenote"))
  114. ;; (slib:load (in-vicinity (program-vicinity) "mwsynrul"))
  115. (slib:load (in-vicinity (library-vicinity) "mwdenote"))
  116. (slib:load (in-vicinity (library-vicinity) "mwsynrul"))
  117.  
  118. (define macro:expand macwork:expand)
  119.  
  120. ;;; Here are EVAL, EVAL! and LOAD which expand macros.  You can replace the
  121. ;;; implementation's eval and load with them if you like.
  122. (define base:eval slib:eval)
  123. (define base:load load)
  124.  
  125. (define (macwork:eval x) (base:eval (macwork:expand x)))
  126. (define macro:eval macwork:eval)
  127.  
  128. (define (macwork:load <pathname>)
  129.   (call-with-input-file <pathname>
  130.     (lambda (port)
  131.       (let ((old-load-pathname *load-pathname*))
  132.     (set! *load-pathname* <pathname>)
  133.     (do ((o (read port) (read port)))
  134.         ((eof-object? o))
  135.       (macro:eval o))
  136.     (set! *load-pathname* old-load-pathname)))))
  137. (define macro:load macwork:load)
  138.  
  139. (provide 'macros-that-work)
  140. (provide 'macro)
  141.